home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pas_0593.zip / SHARLOCK.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-30  |  4KB  |  117 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 435 of 505
  3. From : Bob Swart                           2:281/256.12         25 Apr 93  20:59
  4. To   : Bas van Gaalen                      2:285/209.0
  5. Subj : Multitasking/Share
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Hoi Bas!
  8.  
  9.  >      Currently I'm writing a program which must be able to handle
  10.  > multitask environments.
  11. I have done the same, some time ago.
  12.  
  13.  > I have a share-unit which takes care of the most. But as I'm trying to
  14.  > write a record which is open in another window (of DesqView for
  15.  > instance) then a runtime error 5 appears.
  16. Use the unit below (probably together with your share unit) to LOCK and UNLOCK
  17. the needed records of your file(s). If you notice a record is locked, just wait
  18. until it is unlocked.}
  19.  
  20. {$IFDEF VER70}
  21. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}
  22. {$ELSE}
  23. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}
  24. {$ENDIF}
  25. Unit SharLock;
  26. {
  27.     SharLock 1.0
  28.     Borland Pascal (Objects) 7.0.
  29.     Copyright (c) 14-3-1993 DwarFools & Consultancy by drs. Robert E. Swart.
  30.                             P.O. box 799
  31.                             5702 NP  Helmond
  32.                             The Netherlands
  33.     Code size: 332 bytes
  34.     Data size:   0 bytes
  35.     ------------------------------------------------------------------------
  36.     This unit provides file sharing and record locking facilities.  Read the
  37.     article in the Magazine DOS Special 2/93 for more information about this
  38.     unit.
  39. }
  40. Interface
  41. Const
  42.   fmReadOnly  = $00;
  43.   fmWriteOnly = $01;
  44.   fmReadWrite = $02;
  45.  
  46.   fmDenyAll   = $10;
  47.   fmDenyWrite = $20;
  48.   fmDenyRead  = $30;
  49.   fmDenyNone  = $40;
  50.  
  51.   fmNoInherit = $80;
  52.  
  53.   function LockRegion(var F: File; BegByte,NrByte: LongInt): Word;
  54.   function UnLockRegion(var F: File; BegByte,NrByte: LongInt): Word;
  55.  
  56.   function LockRecords(var F: File; RecNr,NrRec: LongInt): Word;
  57.   function UnLockRecords(var F: File; RecNr,NrRec: LongInt): Word;
  58.  
  59. Implementation
  60. Uses Dos;
  61.  
  62.   function FLock(Handle: Word; Pos,Len: LongInt): Word; Assembler;
  63.   ASM
  64.         mov   AL,0      { subfunction 0: lock region }
  65.         mov   AH,$5C    { DOS function $5C: FLOCK    }
  66.         mov   BX,Handle { put FileHandle in BX       }
  67.         les   DX,Pos
  68.         mov   CX,ES     { CX:DX begin position       }
  69.         les   DI,Len
  70.         mov   SI,ES     { SI:DI length lockarea      }
  71.         int   $21
  72.         jb    @End      { if error then return AX    }
  73.         xor   AX,AX     { else return 0              }
  74.     @End:
  75.   end {FLock};
  76.  
  77.   function FUnLock(Handle: Word; Pos,Len: LongInt): Word; Assembler;
  78.   ASM
  79.         mov   AL,1      { subfunct. 1: unlock region }
  80.         mov   AH,$5C    { DOS function $5C: FLOCK    }
  81.         mov   BX,Handle { put FileHandle in BX       }
  82.         les   DX,Pos
  83.         mov   CX,ES     { CX:DX begin position       }
  84.         les   DI,Len
  85.         mov   SI,ES     { SI:DI length lockarea      }
  86.         int   $21
  87.         jb    @End      { if error then return AX    }
  88.         xor   AX,AX     { else return 0              }
  89.     @End:
  90.   end {FUnLock};
  91.  
  92.  
  93.   function LockRegion(var F: File; BegByte,NrByte: LongInt): Word;
  94.   begin
  95.     LockRegion := FLock(FileRec(F).Handle,BegByte,NrByte)
  96.   end {LockRegion};
  97.  
  98.   function UnLockRegion(var F: File; BegByte,NrByte: LongInt): Word;
  99.   begin
  100.     UnLockRegion := FUnLock(FileRec(F).Handle,BegByte,NrByte)
  101.   end {UnLockRegion};
  102.  
  103.  
  104.   function LockRecords(var F: File; RecNr,NrRec: LongInt): Word;
  105.   begin
  106.     LockRecords := FLock(FileRec(F).Handle,
  107.                            (RecNr * FileRec(F).RecSize)-1,
  108.                             NrRec * FileRec(F).RecSize)
  109.   end {LockRecords};
  110.  
  111.   function UnLockRecords(var F: File; RecNr,NrRec: LongInt): Word;
  112.   begin
  113.     UnLockRecords := FUnLock(FileRec(F).Handle,
  114.                                (RecNr * FileRec(F).RecSize)-1,
  115.                                 NrRec * FileRec(F).RecSize)
  116.   end {UnLockRecords};
  117. end.